A projekthez a kaggle.com oldalon található, ‘The Movies Dataset’ nevű adathalmazt használtam fel, ami kb. 45 000, 2017. július előtt megjelent film metaadatait tartalmazza, kb. 270 000 felhasználói értékeléssel együtt.
Főbb adatpontok: megjelenési idő, nyelv, büdzsé, bevétel, értékelések, hossz, kulcsszavak a cselekményhez
Forrás: https://www.kaggle.com/rounakbanik/the-movies-dataset
A projektben felhasznált könyvtárak: ‘tidyverse’ szupercsomag, ‘jsonlite’, lubridate, wordcloud, reshape2, ggrepel, scales
library(tidyverse)
library(jsonlite)
library(lubridate)
library(wordcloud)
library(reshape2)
library(ggrepel)
library(scales)
Az egyszerű ‘read.csv’ függvénnyel történik a beolvasás, mert a használt adatok a klasszikus angolszász módon (oszlopok vesszővel elválasztva, tizedesvesszők ponttal jelölve) vannak formázva. Először beállítjuk a munkamappát (ez R Notebook futtatásakor egyébként alapértelmezetten a fájt tartalmazó könyvtár), majd innen importáljuk az adatokat, kettő különböző fájlból.
setwd("C://Users/balin/Dropbox/Docs/University material/BMT TTK CogSci 2017-2018 II/R/notebook")
movies_metadata <- read.csv("movies_metadata.csv")
keywords <- read.csv("keywords.csv")
Mivel kettő különböző táblába tároltuk el a két fájl tartalmát, szükség lesz egy key-re, amivel azonosíthatjuk egymással az egyes megfigyeléseket. Az “id” nevű változó fogja betölteni ezt a szerepet. Amikor először leelenőrizzük, hogy több megfigyeléshez is tartozik-e egy kulcs, fény derül arra is, hogy miért van eltérő számú megfigyelés a fájlokban: néhány megfigyelés duplikált.
movies_metadata %>%
count(id) %>%
filter(n > 1)
keywords %>%
count(id) %>%
filter(n > 1)
Belenézve az adatokba kiderül, hogy ezek egyszerű duplikációk, így elég, ha egyet megtartunk belőlük a ‘distinct’ dplyr függvénnyel.
movies_metadata <- distinct(movies_metadata)
keywords <- distinct(keywords)
Kapcsoljuk hozzá a fő movies_metadata adattáblához a másik táblát is egy új, movies táblában. Az ‘inner_join’ függvényt használjuk, hogy csak azok az esetek kerüljenek be a végleges adathalmazba, amiről mindkét táblában volt adat.
movies <- inner_join(movies_metadata, keywords, by="id")
Hibaüzenetet kapunk. Próbáljuk meg integer típusra konvertálni az “id” változót mindkét táblában, majd próbáljuk újra a kapcsolást (és dobjuk is a többé nem használt táblákat).
movies_metadata$id <- as.integer(as.character(movies_metadata$id))
keywords$id <- as.integer(as.character(keywords$id))
movies <- inner_join(movies_metadata, keywords, by="id")
rm(movies_metadata, keywords)
Ezúttal sikerült. Kettő, a későbbi elemzés szempontjából fontos változó (genre, keywords) értéke nem egyértelmű formátumban van megadva. Az adatok dokumentációjában olvasható, hogy ezek JSON objektumok (pontosabban ezek vektorai). Egy példa:
movies$genres[1]
## [1] [{'id': 16, 'name': 'Animation'}, {'id': 35, 'name': 'Comedy'}, {'id': 10751, 'name': 'Family'}]
## 4066 Levels: [] ...
Ezeket szeretnék egyszerűbb listává alakítani, csak a műfajok nevével. Létezik egy olyan R-csomag, ami képes a JSON és az R adattípusok között konvertálni, ez a jsonlite. Sajnos, ha megpróbáljuk a csomag ‘fromJSON’ függvényével első nekifutásra átkonvertálni ezeket az értékeket, hibaüzenetet kapunk arról, hogy nem ismeri fel az argumentumot mint JSON objektumot.
Némi utánajárás után kiderül, hogy a probléma ott van, hogy JSON-ban dupla idézőjelet használnak, nem szimplát. Cseréljük ki ezeket a karaktereket az említett változóknál a ‘gsub’ függvénnyel, de úgy, hogy a szövegben mint stringben előforduló aposztrofok ne sérüljenek. Ezt RegEx-el oldjuk meg. Kivesszük továbbá a később amúgy sem használt backslasheket a keywords változó értékeiből, mert azok is zavarják a JSON parsert.
movies$genres <- gsub("'(?=\\:|\\,|\\})|(?<=\\{|\\:\\s|\\,\\s)'", "\"", movies$genres, perl = TRUE)
movies$keywords <- gsub("'(?=\\:|\\,|\\})|(?<=\\{|\\:\\s|\\,\\s)'", "\"", movies$keywords, perl = TRUE)
movies$keywords <- gsub("([\\])","", movies$keywords)
Így már használható a ‘fromJSON’ függvény, amivel már át tudunk menni az egyes változókon, hogy R-kompatibilis listát készítsünk. Csak a name vektorokat tartjuk meg a listákból, az id-ra nem lesz szükség. Végül egyszerűsítsük a listákat homogénebb karaktervektorokká az ‘unlist’ függvénnyel.
movies$genres <- lapply(movies$genres, fromJSON)
movies$genres <- lapply(movies$genres, "[", c("name"))
movies$genres <- lapply(movies$genres, unlist)
movies$keywords <- lapply(movies$keywords, fromJSON)
movies$keywords <- lapply(movies$keywords, "[", c("name"))
movies$keywords <- lapply(movies$keywords, unlist)
Az áttekinthetőség érdekében eltávolítunk néhány oszlopot, amiket biztosan nem tervezünk felhasználni az elemzés során.
movies$belongs_to_collection <- NULL
movies$homepage <- NULL
movies$poster_path <- NULL
movies$production_companies <- NULL
movies$production_countries <- NULL
movies$spoken_languages <- NULL
movies$tagline <- NULL
movies$original_title <- NULL
movies$video <- NULL
Beállítjuk a release_date változó típusát dátumra, mert faktorként volt eddig beolvasva. A lubridate csomag ‘year’ függvényével tudjuk majd ezekből az értékekből kinyerni külön az évet, nézzük erre is egy példát.
movies$release_date <- as.Date(movies$release_date)
year(movies$release_date[1])
## [1] 1995
Megfigyelhető, hogy ebben az adattáblában a budget, revenue és runtime változók hiányzó értékeit 0-val jelölték, ami később torzíthatja az elemzéseinket. Állítsuk át őket a hiányzó értéket jelző értékre.
movies$budget[movies$budget == 0] <- NA
movies$revenue[movies$revenue == 0] <- NA
movies$runtime[movies$runtime == 0] <- NA
A még ki nem adott és a felnőtt filmekre nem leszünk kíváncsiak. Mielőtt azonban ezeket is kiszednénk az adattáblánkból, nézzük meg, hogy hány ilyen film van.
count(movies, adult == "False", status == "Released")
Relative nem sok, szűrjük is ki ezeket.
movies <- filter(movies, adult == "False", status == "Released")
movies$adult <- NULL
movies$status <- NULL
Nagyjából készen vagyunk az adatok előkészítésével. Nézzünk most rájuk tibble formátumban.
as.tibble(movies)
Először nézzük meg, immár a ggplot csomag segítségével, hogy a filmek hogyan oszlanak el időben (év szerint).
ggplot(data = movies) +
geom_bar(mapping = aes(year(release_date)), width = 1) +
labs( x = "Kiadás éve", y = "Filmek száma")
Úgy tűnik, egy fokozatos növekedést követően az ezredforduló környékén kezd el hirtelen megszaporodni a filmek száma – legalábbis az adathalmazban mindenképpen. Hogy ez mennyire reprezentálja a filmmegjelenések valós arányát, az kérdéses.
Nézzük meg ugyanezt, de most külön az angol és nem angol nyelvű filmekre szűrve, és csak a ’60-as évektől felfelé.
movies %>%
filter(original_language == "en", year(release_date) >= 1960) %>%
ggplot(mapping = aes(year(release_date))) +
geom_bar(width = 1) +
labs( x = "Kiadás éve", y = "Filmek száma", title ="Angol nyelvű filmek")
movies %>%
filter(original_language != "en", year(release_date) >= 1960) %>%
ggplot(mapping = aes(year(release_date))) +
geom_bar(width = 1) +
labs( x = "Kiadás éve", y = "Filmek száma", title ="Nem angol nyelvű filmek")
Hasonló mintázatokat látunk (persze eltérő nagyságrendekben), talán annyi különbséggel, hogy a ’70-as és ’90-es évek között mintha átmenetileg csökkent és stagnált volna a nem angol nyelvű filmkiadás. Persze ennek hátterében újfent lehet mintavételi torzítás is.
Nézzük meg a filmek értékelésének és hosszának eloszlását. Mivel egyébként első ránézésre furcsa szélsőértékeket is felvesz a runtime változó (az 1200 perc hosszú film elég extrémnek tűnik, feltehetőleg egy sorozatról van itt szó), szűrjük az eseteinket a max. 450 perces filmekre, ez a “Sátántangó” című Tarr Béla-film hossza, amit már komoly kihívás egyben végignézni.
movies %>%
filter(vote_count >= 100) %>%
ggplot(mapping = aes(vote_average)) +
geom_density(kernel="gaussian") +
labs( x = "Értékelés", y = "Sűrűség")
movies %>%
filter(runtime <= 450) %>%
ggplot(mapping = aes(runtime)) +
geom_density(kernel="gaussian") +
labs( x = "Hossz", y = "Sűrűség")
A filmek értékelésénél szűrtünk a legalább 100 értékelést kapott filmekre enyhén ferde, de normálnak mondható előszlást kaptunk (egy 6-7 közötti módusszal), míg a hossznál egy meglehetősen csúcsosat (90 körüli módusszal).
Most nézzük meg, hogyan viszonyul egymáshoz a filmek kedveltsége és hossza. Ehhez vegyük csak azokat a filmeket, amikre legalább 100 értékelés érkezett, maximum 250 percesek, és 1960 után jelentek meg.
movies %>%
filter(
runtime <= 250,
vote_count >= 100,
year(release_date) >= 1960
) %>%
ggplot(mapping = aes(runtime, vote_average)) +
geom_point(position="jitter", size = 1, alpha = 2/10) +
labs( x = "Hossz", y = "Kedveltség")
Úgy tűnik, minél kedveltebb egy film, annál valószínőbb, hogy deviál az átlagos 90-100 perc körüli hossztól valamely irányban. Nézzük meg csak a 90 és 250 perc közötti filmekre ugyanezt, és színezzük a pontokat a megjelenés éve szerint.
movies %>%
filter(
between(runtime, 90, 250),
vote_count >= 100,
year(release_date) >= 1960
) %>%
ggplot(mapping = aes(runtime, vote_average, colour = year(release_date))) +
geom_point(position="jitter", size = 0.6) +
geom_smooth(method = "gam") +
labs( x = "Hossz", y = "Kedveltség", colour ="Megjelenés éve")
A mintázat azt sejteti, mintha 90 perc felett lenne egy enyhe korreláció a hossz és a kedveltség között.
Tárjuk fel egy kicsit szemléletesebben ezt a mintázatot: hozzunk létre övezeteket az évszámokból, és fazettázzuk a pontfelhőt ezek szerint. Így ráláthatunk, hogyan járulnak hozzá az egyes időszakokban megjelent filmek a fenti mintázathoz.
movies <- movies %>%
mutate(decade = case_when(
(year(release_date) >= 1910 & year(release_date) < 1920) ~ "1910s",
(year(release_date) >= 1920 & year(release_date) < 1930) ~ "1920s",
(year(release_date) >= 1930 & year(release_date) < 1940) ~ "1930s",
(year(release_date) >= 1940 & year(release_date) < 1950) ~ "1940s",
(year(release_date) >= 1950 & year(release_date) < 1960) ~ "1950s",
(year(release_date) >= 1960 & year(release_date) < 1970) ~ "1960s",
(year(release_date) >= 1970 & year(release_date) < 1980) ~ "1970s",
(year(release_date) >= 1980 & year(release_date) < 1990) ~ "1980s",
(year(release_date) >= 1990 & year(release_date) < 2000) ~ "1990s",
(year(release_date) >= 2000 & year(release_date) < 2010) ~ "2000s",
(year(release_date) >= 2010 & year(release_date) < 2020) ~ "2010s")
)
movies$decade <- as.factor(movies$decade)
movies %>%
filter(
between(runtime, 90, 250),
vote_count >= 100,
year(release_date) >= 1960
) %>%
ggplot(mapping = aes(runtime, vote_average)) +
geom_point(position="jitter", size = 1, alpha = 2/10) +
facet_grid(. ~ decade) +
labs( x = "Hossz", y = "Kedveltség")
Nézzük meg azt is, hogy alakul az egyes évtizedekben megjelent filmek átlagos kedveltsége.
movies %>%
filter(
vote_count >= 200,
year(release_date) >= 1960
) %>%
ggplot(mapping = aes(decade, vote_average)) +
geom_boxplot(alpha = 3/10) +
labs( x = "Évtized", y = "Átlagos kedveltség") +
theme_light() +
theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank())
Talán informatívabb, ha nem magukat az átlagokat, hanem az évtizedekhez tartozó eloszlásokat jelenítjük meg egy-egy ábrán.
movies %>%
filter(runtime <= 250, year(release_date) >= 1960) %>%
ggplot(mapping = aes(runtime, colour = decade)) +
geom_density(kernel="gaussian") +
labs( x = "Hossz", y = "Sűrűség", colour ="Évtized",
title="Az egyes évtizedekben megjelent filmek hosszának eloszlása")
movies %>%
filter(vote_count >= 100, year(release_date) >= 1960) %>%
ggplot(mapping = aes(vote_average, colour = decade)) +
geom_density(kernel="gaussian") +
labs( x = "Értékelés", y = "Sűrűség", colour ="Évtized",
title="Az egyes évtizedekben megjelent filmek kedveltségének eloszlása")
Ezeken az ábrákon az látszik, hogy a filmek hossza az időben előre haladva hasonlóan unimodális, de egyre csúcsosabb eloszlást követ. Az egyes évtizedekben megjelent filmek kedveltségének eloszlása pedig az időben előre haladva egyre laposabb, egyre alacsonyabb módusszal.
Térjünk rá a műfajokra. Először nézzük meg, hogy hány egyedi műfaj-címke van egyáltalán a táblában, és mik ezek.
genres_names <- unique(unlist(movies$genres))
genres_names
## [1] "Animation" "Comedy" "Family"
## [4] "Adventure" "Fantasy" "Romance"
## [7] "Drama" "Action" "Crime"
## [10] "Thriller" "Horror" "History"
## [13] "Science Fiction" "Mystery" "War"
## [16] "Foreign" "Music" "Documentary"
## [19] "Western" "TV Movie"
A 20 címke alapján hozzunk létre változókat, melyek logikai vektorok lesznek, az egyes filmekhez tartozó logikai értékkel.
for (i in genres_names) {
movies[[i]] <- unlist(lapply(lapply(movies$genres, is.element, i), any))
}
Így már meg tudjuk nézni például a háborús filmek időbeli eloszlását. Ezúttal a témához illő sötét tónussal megjelenítve.
movies %>%
filter(War == "TRUE") %>%
ggplot(mapping = aes(year(release_date))) +
geom_bar(colour = "black", width = 1) +
labs( x = "Kiadás éve", y = "Filmek száma", title ="Háborús filmek száma") +
theme_dark()
Egy érdekes, ciklikus mintázat látható. Ennél valamivel beszédesebb, ha a háborús filmek arányát ábrázolnánk az egyes időszakokban. Jól látszik, hogy az évezred első felében hangsúlyosabbak voltak ezek a filmek:
movies %>% filter(year(release_date) >= 1925) %>%
ggplot(mapping = aes(year(release_date), fill = War)) +
geom_bar(position ="fill", width = 1) +
labs( x = "Kiadás éve", y = "Filmek száma", title ="Háborús filmek") +
scale_fill_grey(start = 0.8, end = 0.1, na.value = "red", name = "", labels = c("Nem háborús", "Háborús")) +
theme_minimal()
Azt is meg tudjuk nézni, melyik a legkedveltebb és legkevésbé kedvelt műfaj-kombináció (pl. azok között, amelyek minimum százszor fordultak elő a mintában és minimum 100 értékelést kaptak). Ehhez csoportosítsuk az adatainkat aszerint, hogy az egyes műfajoknál milyen logikai értéket vesznek fel, és nézzük meg az átlagos értékelést az egyes kombinációknál, majd ezt a listát rendezzük csökkenő sorrendbe. Ez kicsit trükkös, mert a group_by függvénynek csak úgy lehet vektorizáltan megadni az argumentumait, ha a vektort először átalakítjuk karaktervektorból szimbólumlistává. Eszerint az elemzés szerint önmagában a dráma a legkedveltebb, amit a szerelmi dráma kombináció követ, majd pedig a dráma-vígjáték:
genres_names_dots <- lapply(genres_names, as.symbol)
movies %>%
filter(vote_count >= 100) %>%
group_by(.dots = genres_names_dots) %>%
summarize(
count = n(),
avg_vote = mean(vote_average)
) %>%
filter(count >= 100) %>%
arrange(desc(avg_vote))
Alapvető probléma, hogy egy filmhez több műfajkategória is tartozik, és ezek széles formában vannak az adattáblában reprezentálva, ami nehézzé teszi csak az egyes műfajok plottolását. Szerencsére a reshape2 csomag ‘melt’ függvényével átalakítható ez a reprezentáció hosszú formába. Így egy film több sorban is szerepelhet, attól függően, hány műfajhoz tartozik.
movies_long <- melt(movies,
id.vars = c("title", "id", "imdb_id", "release_date", "decade",
"runtime", "budget", "revenue", "vote_average",
"vote_count", "keywords"),
measure.vars = genres_names, variable.name = "Genre") %>%
filter(value == "TRUE")
movies_long$value <- NULL
Az új data.frame segítségével már tudjuk ábrázolni például az egyes műfajok átlagos kedveltségét és hosszát. Hasonlítsuk össze a nagyobb időtávban megjelent filmeket az 1960-as és a 2010-es évek megjelenéseinek plottolásán keresztül
movies_long %>%
filter(vote_count >= 10,
between(year(release_date), 2010, 2020)
| between(year(release_date), 1960, 1969)) %>%
ggplot(mapping = aes(Genre, vote_average)) +
stat_summary(
fun.ymin = min,
fun.ymax = max,
fun.y = mean
) +
labs( x = "", y = "Kedveltség",
title = "A legalább 10 szavazatot kapott filmek átlagos kedveltsége műfajonként") +
coord_flip() +
facet_grid(. ~ decade)
movies_long %>%
filter(between(runtime, 60, 180),
between(year(release_date), 2010, 2020)
| between(year(release_date), 1960, 1969)) %>%
subset(!is.na(runtime)) %>%
ggplot(mapping = aes(Genre, runtime)) +
stat_summary(
fun.ymin = min,
fun.ymax = max,
fun.y = mean
) +
labs( x = "", y = "Hossz",
title = "60 - 180 perc közötti filmek átlagos hossza műfajonként") +
coord_flip() +
facet_grid(. ~ decade)
Nézzük meg, hogy az egyes évtizedek filmjei közül melyek a legnépszerűbbek és legkevésbé népszerűek egy-egy műfajban.
movies_long %>%
subset(!is.na(decade)) %>%
filter(vote_count >= 100) %>%
group_by(Genre, decade) %>%
summarize(
BestVote = max(vote_average), BestTitle = title[which.max(vote_average)],
WorstVote = min(vote_average), WorstTitle = title[which.min(vote_average)])
A kulcsszavak esetén már sokkal több egyedi értékünk van. Nézzük meg az első 50 leggyakoribbat.
sort(table(unlist(movies$keywords)), decreasing=TRUE)[1:50]
##
## woman director independent film murder
## 3012 1895 1280
## based on novel musical sex
## 817 718 676
## violence nudity revenge
## 645 625 616
## biography suspense love
## 610 575 560
## female nudity sport police
## 554 528 450
## duringcreditsstinger teenager sequel
## 440 432 429
## friendship world war ii drug
## 406 390 357
## stand-up comedy prison high school
## 347 346 313
## martial arts suicide rape
## 310 306 302
## film noir silent film kidnapping
## 301 301 299
## family serial killer monster
## 289 288 277
## alien dystopia new york
## 274 268 265
## paris blood gay
## 265 262 258
## short marriage christmas
## 254 253 249
## gore death gangster
## 242 241 241
## small town zombie detective
## 236 235 233
## aftercreditsstinger london england
## 231 231
Nézzük meg évtizedek szerinti bontásban az első 5 leggyakoribbat.
movies %>%
subset(!is.na(decade)) %>%
group_by(decade) %>%
summarize(
Key1 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[1],
Key2 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[2],
Key3 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[3],
Key4 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[4],
Key5 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[5],)
Használjuk a wordcloud csomagot szófelhő készítésére az első 100 leggyakoribb kulcsszóból (mondjuk az 1960 és 1990 közötti filmeknél).
library(RColorBrewer)
keysfreq <- as.data.frame(
sort(table(unlist(
filter(movies, between(year(release_date), 1960, 1990))$keywords)),
decreasing=TRUE)
[1:100])
pal <- brewer.pal(8,"Dark2")
pal <- pal[-(1:2)]
wordcloud(words = keysfreq$Var1, freq = keysfreq$Freq,
random.order=FALSE, scale=c(4,.5), rot.per=0, fixed.asp=FALSE, colors=pal)
A magyar nyelvű filmek kulcsszavai:
library(RColorBrewer)
keysfreq <- as.data.frame(
sort(table(unlist(
filter(movies, original_language == "hu")$keywords)),
decreasing=TRUE)
[1:100])
pal <- brewer.pal(9, "BuGn")
pal <- pal[-(1:2)]
wordcloud(words = keysfreq$Var1, freq = keysfreq$Freq,
random.order=FALSE, scale=c(4,.5), rot.per=0, fixed.asp=FALSE, colors=pal)
Érdekesség, hogy ggplottal is lehet szófelhőt generálni. Ehhez még szükség lesz a ggrepel csomagra is. (http://mhairihmcneill.com/blog/2016/04/05/wordclouds-in-ggplot.html)
Nézzük meg ezzel a módszerrel, hogy mennyiben mások a kulcsszavak az 1920 és 1950 között megjelent filmeknél.
keysfreq <- as.data.frame(
sort(table(unlist(
filter(movies, between(year(release_date), 1920, 1950))$keywords)),
decreasing=TRUE)
[1:50])
keysfreq %>%
ggplot +
aes(x = 1, y = 1, size = Freq, colour = Freq, label = Var1) +
geom_text_repel(segment.alpha = 0, force = 50) +
scale_size(range = c(2, 10), guide = FALSE) +
scale_y_continuous(breaks = NULL) +
scale_x_continuous(breaks = NULL) +
labs(x = '', y = '', colour = 'Gyakoriság', title ='Az 1920-1950-es korszak filmjeinek kulcsszavai') +
scale_colour_gradient(low="blue", high="orange") +
theme_classic()
A pénzügyekre is kíváncsiak vagyunk, bár azokról elég ritkák az adataink: jelen esetben első pillantásra felmerül a gyanú, hogy a budget és revenue változók értékei gyakran hiányoznak. Nézzük meg, hányszor van ilyen.
count(movies, is.na(budget), is.na(revenue))
Sajnos meglepően sokszor: mindössze 5377 olyan eset van, ahol az értékek nem hiányoznak.
Nézzük meg milyen kapcsolat van a filmek költségvetése / bevétele és kedveltsége között. (Mivel nincs sok adatpontunk ezen változók mentén, most ne bontsuk tovább őket évtized / műfaj / nyelv szerint.)
movies %>%
subset(!is.na(budget) & !is.na(vote_average)) %>%
filter(revenue > 0, vote_count >= 10) %>%
ggplot(mapping = aes(vote_average, budget)) +
geom_smooth(size = 1, fullrange = FALSE, colour = "blue", se = FALSE) +
labs( x = "Kedveltség", y = "Költségvetés (dollár)") +
scale_y_continuous(labels = dollar) +
theme_light()
movies %>%
subset(!is.na(revenue) & !is.na(vote_average)) %>%
filter(revenue > 0, vote_count >= 10) %>%
ggplot(mapping = aes(vote_average, revenue)) +
geom_smooth(size = 1, fullrange = FALSE, colour = "red", se = FALSE) +
labs( x = "Kedveltség", y = "Bevétel (dollár)") +
scale_y_continuous(labels = dollar) +
theme_light()
A filmek kedveltsége és bevétele között láthatóan erős összefüggés van. A kedveltség és költségvetés között már egy érdekesebb, fordított U összefüggést látunk: a közepes, 5-6-os értékelésig ahogy nő a kiadás, úgy nő az értékelés, ezt követően azonban megfordul a viszony (érdemes persze megnézni a skálán ennek a nagyságrendjét)
Végül pedig nézzük meg az összefüggést a filmek költségvetése és bevétele között. Egy
movies %>%
subset(!is.na(budget) & !is.na(revenue)) %>%
ggplot(mapping = aes(budget, revenue)) +
geom_point(position="jitter", size = 1, alpha = 10/10, colour = "yellow") +
geom_smooth(size = 1, fullrange = FALSE, colour = "orange", se = FALSE) +
labs( x = "Költségvetés (dollár)", y = "Bevétel (dollár)") +
scale_y_continuous(labels = dollar) +
scale_x_continuous(labels = dollar) +
theme_light()